home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / mxlibs / dwstk102 / playdwm.pas < prev    next >
Pascal/Delphi Source File  |  1995-04-12  |  6KB  |  265 lines
  1. (******************************************************************************
  2. File:                          playdwm.pas 1.02
  3. Tab stops:                 every 2 columns
  4. Project:                     DWM Player
  5. Copyright:                 1994-1995 DiamondWare, Ltd.    All rights reserved.
  6. Written:                     Keith Weiner & Erik Lorenzen
  7. Pascal Conversion: David A. Johndrow
  8. Purpose:                     Contains simple example code to show how to load/play a
  9.                                      .DWM file
  10. History:                     94/10/21 KW Started playdwm.c
  11.                                      94/11/12 DJ Translated to Pascal
  12.                                      95/01/12 EL Finalized
  13.                                      95/03/22 EL Finalized for 1.01
  14.                                      95/04/11 EL Finalized for 1.02
  15.  
  16. Notes
  17. -----
  18. This code isn't really robust when it comes to standard error checking
  19. and particularly recovery, software engineering technique, etc.  A buffer
  20. is statically allocated.    A better technique would be to use fstat() or stat()
  21. to determine the file's size then malloc(size).  The STK will handle songs
  22. larger than 64K (but not digitized sounds).  Obviously, you'd need to fread()
  23. such a file in chunks, or write some sort of hfread() (huge fread).  Also,
  24. exitting and cleanup is not handled robustly in this code.    The code below can
  25. only be validated by extremely careful scrutiny to make sure each case is
  26. handled properly.  A better method would the use of C's atexit function.
  27.  
  28. But all such code would make this example file less clear; its purpose was
  29. to illustrate how to call the STK, not how to write QA-proof software.
  30. ******************************************************************************)
  31.  
  32.  
  33.  
  34. Program PlayDWM;
  35.  
  36. uses crt, err, dws;
  37.  
  38.  
  39.  
  40. var
  41.     ExitSave: pointer;
  42.  
  43.     song:              pointer;
  44.     fp:                  file;
  45.     dov:                 dws_DOPTR;
  46.     dres:              dws_DRPTR;
  47.     ideal:             dws_IDPTR;
  48.     mplay:             dws_MPPTR;
  49.     ch:                  char;
  50.     musvol:          word;
  51.     errno:             word;
  52.     songplaying: word;
  53.     songsize:      longint;
  54.  
  55.  
  56.  
  57. Function Exist(FileName: string): boolean;
  58. Var
  59.     Fil: File;
  60.  
  61. begin
  62.     Assign(Fil,FileName);
  63.     {$I- }
  64.     Reset(Fil);
  65.     Close(Fil);
  66.     {$I+ }
  67.  
  68.     Exist := (IOResult = 0);
  69. end;
  70.  
  71.  
  72.  
  73. procedure ExitPlay; far;
  74.  
  75. label TRYTOKILLAGAIN;
  76.  
  77. begin
  78.     ExitProc := ExitSave;
  79.  
  80.     (* If dwt is not inited calling dwt_Kill will have no effect *)
  81.     dwt_Kill;
  82.  
  83. TRYTOKILLAGAIN:
  84.  
  85.     if (dws_Kill <> 1) then
  86.     begin
  87.         (*
  88.          . If an error occurs here, it's either dws_Kill_CANTUNHOOKISR
  89.          . or dws_NOTINITTED.  If it's dws_Kill_CANTUNHOOKISR the user
  90.          . must remove his tsr, and dws_Kill must be called again.    If it's
  91.          . dws_NOTINITTED, there's nothing to worry about at this point.
  92.         *)
  93.         err_Display;
  94.  
  95.         if (dws_ErrNo = dws_Kill_CANTUNHOOKISR) then
  96.         begin
  97.             goto TRYTOKILLAGAIN;
  98.         end;
  99.     end;
  100.  
  101.     if (song <> nil) then
  102.     begin
  103.         freemem(song, songsize);
  104.     end;
  105.  
  106.     dispose(mplay);
  107.     dispose(ideal);
  108.     dispose(dres);
  109.     dispose(dov);
  110.  
  111. end;
  112.  
  113.  
  114.  
  115. begin
  116.     ExitSave := ExitProc;
  117.     ExitProc := @ExitPlay;
  118.  
  119.     writeln;
  120.     writeln('PLAYDWM 1.02 is Copyright 1994-95, DiamondWare, Ltd.');
  121.     writeln('All rights reserved.');
  122.     writeln;
  123.     writeln;
  124.  
  125.     new(dov);
  126.     new(dres);
  127.     new(ideal);
  128.     new(mplay);
  129.  
  130.     song     := nil;
  131.     musvol := 255; (* Default mxr volume at startup is max *)
  132.     ch         := '0';
  133.  
  134.     if (ParamCount = 0) then
  135.     begin
  136.         writeln('Usage PLAYDWM <dwm-file>');
  137.         halt(65535);
  138.     end;
  139.  
  140.     if Exist(ParamStr(1)) then
  141.     begin
  142.         Assign(fp, ParamStr(1));
  143.         Reset(fp,1);
  144.         songsize := filesize(fp);
  145.  
  146.         (* Please note we don't check to see if we get the memory we need. *)
  147.         Getmem(song, songsize);
  148.         BlockRead(fp,song^,songsize);
  149.  
  150.         Close(fp);
  151.     end
  152.     else
  153.     begin
  154.         writeln('Unable to open '+ParamStr(1));
  155.         halt(65535);
  156.     end;
  157.  
  158.     (*
  159.      . We need to set every field to -1 in dws_DETECTOVERRIDES record; this
  160.      . tells the STK to autodetect everything.    Any other value
  161.      . overrides the autodetect routine, and will be accepted on
  162.      . faith, though the STK will verify it if possible.
  163.     *)
  164.     dov^.baseport := 65535;
  165.     dov^.digdma     := 65535;
  166.     dov^.digirq     := 65535;
  167.  
  168.     if (dws_DetectHardWare(dov, dres) = 0) then
  169.     begin
  170.         err_Display;
  171.         halt(65535);
  172.     end;
  173.  
  174.     (*
  175.      . The "ideal" record tells the STK how you'd like it to initialize the
  176.      . sound hardware.    In all cases, if the hardware won't support your
  177.      . request, the STK will go as close as possible.  For example, not all
  178.      . sound boards will support al sampling rates (some only support 5 or
  179.      . 6 discrete rates).
  180.     *)
  181.     ideal^.musictyp     := 1;         (*for now, it's OPL2 music*)
  182.     ideal^.digtyp         := 0;         (*0=No Dig, 8=8bit, 16=16bit*)
  183.     ideal^.digrate        := 0;         (*sampling rate, in Hz*)
  184.     ideal^.dignvoices := 0;         (*number of voices (up to 16)*)
  185.     ideal^.dignchan     := 0;         (*1=mono, 2=stereo*)
  186.  
  187.     if (dws_Init(dres, ideal) = 0) then
  188.     begin
  189.         err_Display;
  190.         halt(65535);
  191.     end;
  192.  
  193.     (*
  194.      .    72.8Hz is a decent compromise.    It will work in a Windows DOS box
  195.      .    without any problems, and yet it allows music to sound pretty good.
  196.      .    In my opinion, there's no reason to go lower than 72.8 (unless you
  197.      .    don't want the hardware timer reprogrammed)--music sounds kinda chunky
  198.      .    at lower rates.  You can go to 145.6 Hz, and get smoother (very
  199.      .    subtly) sounding music, at the cost that it will NOT run at the correct
  200.      .    (or constant) speed in a Windows DOS box.}
  201.     *)
  202.     dwt_Init(dwt_72_8HZ);
  203.  
  204.     (* Set music volume to about 80% max *)
  205.     musvol := 200;
  206.  
  207.     if (dws_XMusic(musvol) = 0) then
  208.     begin
  209.         err_Display;
  210.     end;
  211.  
  212.     mplay^.track := song;
  213.     mplay^.count := 1;
  214.  
  215.     if (dws_MPlay(mplay) = 0) then
  216.     begin
  217.         err_Display;
  218.         halt(65535);
  219.     end;
  220.  
  221.     (*
  222.      . We're playing.  Let's exit when the song is over, and allow the user
  223.      . to fiddle with the volume level (mixer) in the meantime
  224.     *)
  225.     writeln('Press + or - to change playback volume ');
  226.  
  227.     repeat
  228.     begin
  229.         if(dws_MSongStatus(@songplaying) = 0) then
  230.         begin
  231.             err_Display;
  232.             halt(65535);
  233.         end;
  234.  
  235.         if Keypressed then begin
  236.             ch := readkey;
  237.             case ord(ch) of
  238.                 43:
  239.                 begin
  240.                     inc(musvol);
  241.                     writeln('Music Volume is ', musvol);
  242.  
  243.                     if (dws_XMusic(musvol) = 0) then
  244.                     begin
  245.                         err_Display;
  246.                     end;
  247.                 end;
  248.                 45:
  249.                 begin
  250.                     dec(musvol);
  251.                     writeln('Music Volume is ', musvol);
  252.  
  253.                     if (dws_XMusic(musvol) = 0) then
  254.                     begin
  255.                         err_Display;
  256.                     end;
  257.                 end;
  258.             end;
  259.         end;
  260.     end;
  261.     until (songplaying = 0) or (ch = 'q') or (ch = 'Q') or (ch = chr(27));
  262.  
  263.     halt(65535);
  264. end.
  265.